Preprocessing

Are there unconscious visual images in aphantasia? Development of an implicit priming paradigm

Modified

20/09/2024

Abstract
For some people the experience of visual imagery is lacking, a condition recently referred to as aphantasia. So far, most of the studies on aphantasia rely on subjective reports, leaving the question of whether mental images can exist without reaching consciousness unresolved. In the present study, the formation of mental images was estimated in individuals with aphantasia without explicitly asking them to generate mental images. 151 Participants performed an implicit priming task where a probe is assumed to automatically reactivate a mental image. An explicit priming task, where participants were explicitly required to form a mental image after a probe, served as a control task. While control participants showed a priming effect in both the implicit and explicit tasks, aphantasics did not show any priming effects. These results suggest that aphantasia relies on a genuine inability to generate mental images rather than on a deficit in accessing these images consciously. Our priming paradigm might be a promising tool for characterizing mental images without relying on participant introspection.
Keywords

Aphantasia, visual imagery, sensory priming


# Packages ----------------------------------------------------------------

# using a reproducible environment
renv::restore()

# the cmdstanr package for Bayesian modelling has to be installed manually
# install.packages(
#   "cmdstanr", 
#   repos = c('https://stan-dev.r-universe.dev', getOption("repos")))

# The cmdstan backend, if not already installed, has to be installed on your 
# computer first, outside of the project:
# check_cmdstan_toolchain() # check if RTools is setup
# nb_cores <- parallel::detectCores() - 1
# install_cmdstan(cores = nb_cores)

# pacman allows to check/install/load packages with a single call
# if (!require("pacman")) install.packages("pacman") # already in renv.lock
library("pacman")

# packages to load (and install if needed) -------------------------------
pacman::p_load(
  here,      # easy file paths
  see,       # theme_modern and okabeito palette
  report,    # reporting various info 
  labelled,  # labelled data
  quarto,
  # ---- Modelling
  easystats, # modelling package framework
  lme4,      # mixed-effects models
  car,       # companion to lme4
  simr,      # power analysis
  statmod,   # power analysis
  emmeans,   # post-hoc tests
  # ---- Bayesian modelling
  brms,      # Bayesian regression models
  tidybayes, # tidy output for brms
  bayesplot, # Bayesian visualisations
  cmdstanr,  # Stan interface
  
  # ---- Visualisations
  qqplotr,    # QQ plots
  scales,     # ggplot2 scales
  latex2exp,  # LaTeX expressions in ggplot2
  ggbeeswarm, # beeswarm plots
  ggpubr,     # publication-ready plots
  patchwork,  # combining plots
  # ---- Data wrangling
  readxl,
  openxlsx,
  tidyverse  # modern R ecosystem
)


# Custom functions shared across scripts ----------------------------------
source(here("scripts/_functions.R"))


# Global cosmetic theme ---------------------------------------------------

theme_set(theme_modern(base_size = 14)) # from see in easystats

# setting my favourite palettes as ggplot2 defaults
options( 
  ggplot2.discrete.colour   = scale_colour_okabeito,
  ggplot2.discrete.fill     = scale_fill_okabeito,
  ggplot2.continuous.colour = scale_colour_viridis_c,
  ggplot2.continuous.fill   = scale_fill_viridis_c
)


# Fixing a seed for reproducibility ---------------------------------------
set.seed(14051998)


# Adding all packages' citations to a .bib --------------------------------
knitr::write_bib(c(.packages()), file = here("bibliography/packages.bib"))

Down below is the code for the outlier selection procedure described in the manuscript.

Importing and cleaning questionnaire data
df_questionnaires <- 
  read_excel(
    here("data/data-raw/priming-data-raw.xlsx"),
    sheet = "data_questionnaires"
  ) |>
  mutate(
    sub_group = case_when(
      vviq80 == 16 ~ "Aphantasia",
      vviq80 > 16 & vviq80 < 32 ~ "Hypophantasia",
      vviq80 >= 32 & vviq80 < 74 ~ "Control",
      vviq80 >= 74 ~ "Hyperphantasia"
      ), 
    sub_group = factor(
      sub_group, 
      levels = c("Hyperphantasia", "Control", "Hypophantasia", "Aphantasia"))
    ) |> 
  rename(
    "VVIQ" = vviq80,
    "OSIQ_Object" = osiq_o75,
    "OSIQ_Spatial" = osiq_s75,
    "SUIS" = suis60
  )
Preprocessing for the explicit task
df_e_acc <- 
  read_excel(
    here("data/data-raw/priming-data-raw.xlsx"),
    sheet = "data_explicit"
  ) |>
  clean_variables() |> # see _functions.R
  set_variable_labels(correct_explicit = "Correct response") |> 
  # filtering out...
  filter(
    # participants identified with with high error rates
    !(subjectid %in% c( 
      "subject_7",
      "subject_94", 
      "subject_25", 
      "subject_4",
      "subject_97")) &
    # participants with aberrant means
    !(subjectid %in% c(
      "subject_49",
      "subject_59",
      "subject_107",
      "subject_100",
      "subject_73",
      "subject_106",
      "subject_119"
    )) 
  ) |>
  mutate(
    sub_group = case_when(
      vviq80 == 16 ~ "Aphantasia",
      vviq80 > 16 & vviq80 < 32 ~ "Hypophantasia",
      vviq80 >= 32 & vviq80 < 74 ~ "Control",
      vviq80 >= 74 ~ "Hyperphantasia"
    ), 
    sub_group = factor(
      sub_group, 
      levels = c("Hyperphantasia", "Control", "Hypophantasia", "Aphantasia"))
  ) |> 
  # removing irrelevant variables
  select(!c(sex, vviq80, orientation, response)) |>  
  # filtering out extreme RTs
  filter(rt > .3 & rt < 3)

df_e_rt <- 
  df_e_acc |> 
  filter(correct_explicit == 1) |> 
  select(!correct_explicit)

# removing hyperphantasia for finer analyses
df_e_finer <- df_e_rt |> filter(sub_group != "Hyperphantasia")
Preprocessing for the implicit task
df_i_acc <- 
  read_excel(
    here("data/data-raw/priming-data-raw.xlsx"),
    sheet = "data_implicit"
  ) |> 
  clean_variables() |>
  set_variable_labels(correct_implicit = "Correct response") |>
  # filtering out...
  filter(
    # participants identified with with high error rates
    !(subjectid %in% c(
      "subject_21",
      "subject_56",
      "subject_9")) &
      # participants with aberrant means
      !(subjectid %in% c(
        "subject_49",
        "subject_107",
        "subject_30",
        "subject_120",
        "subject_127"
      ))
  ) |>
  mutate(
    sub_group = case_when(
      vviq80 == 16 ~ "Aphantasia",
      vviq80 > 16 & vviq80 < 32 ~ "Hypophantasia",
      vviq80 >= 32 & vviq80 < 74 ~ "Control",
      vviq80 >= 74 ~ "Hyperphantasia"
    ), 
    sub_group = factor(
      sub_group, 
      levels = c("Hyperphantasia", "Control", "Hypophantasia", "Aphantasia"))
  ) |> 
  # removing irrelevant variables
  select(!c(sex, vviq80, orientation, response)) |>  
  # filtering out extreme RTs
  filter(rt > .3 & rt < 3)

df_i_rt <-
  df_i_acc |> 
  filter(correct_implicit == 1) |> 
  select(!correct_implicit)

# removing hyperphantasia for finer analyses
df_i_finer <- df_i_rt |> filter(sub_group != "Hyperphantasia")
Adding congruence effects to the questionnaire data
congruence_effects <-
  list(
    df_e_rt = df_e_rt,
    df_i_rt = df_i_rt
  ) |> 
  imap(
    ~.x |> 
      group_by(subjectid, congruence, color) |> 
      reframe(mean_rt = mean(rt)) |> 
      group_by(subjectid, congruence) |> 
      reframe(mean = mean(mean_rt)) |> 
      pivot_wider(
        names_from = congruence,
        values_from = mean
      ) |> 
      mutate(congruence_effect = Incongruent - Congruent, .keep = "unused") |> 
      ungroup()
  )

df_questionnaires <- 
  df_questionnaires |>
  left_join(congruence_effects[["df_e_rt"]], by = "subjectid") |>
  rename("Explicit effect" = congruence_effect) |>
  left_join(congruence_effects[["df_i_rt"]], by = "subjectid") |> 
  rename("Implicit effect" = congruence_effect) |> 
  select(
    subjectid:aphantasia, sub_group,
    contains("Imp"), contains("Exp"), 
    "VVIQ":"SUIS"
  ) |> 
  group_by(aphantasia) |> 
  mutate(across(
    contains("effect"),
    ~if_else(is.na(.x), mean(.x, na.rm = TRUE), .x))) |> 
  ungroup()
Creating ranked and normalized scores
df_q_ranked <- df_questionnaires |> mutate(across(VVIQ:SUIS, rank))

df_q_norm <- 
  df_questionnaires |>
  mutate(
    VVIQ = as.numeric(
      scales::rescale(
        VVIQ, 
        from = c(16, 80), 
        to = c(0, 1))),
    SUIS = as.numeric(
      scales::rescale(
        SUIS, 
        from = c(12, 60), 
        to = c(0, 1))),
    OSIQ_Object = as.numeric(
      scales::rescale(
        OSIQ_Object, 
        from = c(15, 75), 
        to = c(0, 1))),
    OSIQ_Spatial = as.numeric(
      scales::rescale(
        OSIQ_Spatial, 
        from = c(15, 75), 
        to = c(0., 1)))
  )

     

═════════════════════════════════════════════════════════════════════════
Analyses were conducted using the R Statistical language (version 4.4.1; R Core
Team, 2024) on Windows 11 x64 (build 22631)
Packages used:
  - quarto (version 1.4.4; Allaire J, Dervieux C, 2024)
  - qqplotr (version 0.0.6; Almeida A et al., 2018)
  - lme4 (version 1.1.35.5; Bates D et al., 2015)
  - Matrix (version 1.7.0; Bates D et al., 2024)
  - effectsize (version 0.8.9; Ben-Shachar MS et al., 2020)
  - brms (version 2.21.0; Bürkner P, 2017)
  - ggbeeswarm (version 0.7.2; Clarke E et al., 2023)
  - Rcpp (version 1.0.12; Eddelbuettel D et al., 2024)
  - car (version 3.1.2; Fox J, Weisberg S, 2019)
  - carData (version 3.0.5; Fox J et al., 2022)
  - cmdstanr (version 0.8.1; Gabry J et al., 2024)
  - bayesplot (version 1.11.1; Gabry J, Mahr T, 2024)
  - statmod (version 1.5.0; Giner G, Smyth GK, 2016)
  - simr (version 1.0.7; Green P, MacLeod CJ, 2016)
  - lubridate (version 1.9.3; Grolemund G, Wickham H, 2011)
  - ggpubr (version 0.6.0; Kassambara A, 2023)
  - tidybayes (version 3.0.6; Kay M, 2023)
  - labelled (version 2.13.0; Larmarange J, 2024)
  - emmeans (version 1.10.3; Lenth R, 2024)
  - parameters (version 0.22.0; Lüdecke D et al., 2020)
  - performance (version 0.12.0; Lüdecke D et al., 2021)
  - easystats (version 0.7.2; Lüdecke D et al., 2022)
  - see (version 0.8.4; Lüdecke D et al., 2021)
  - insight (version 0.20.1; Lüdecke D et al., 2019)
  - bayestestR (version 0.13.2; Makowski D et al., 2019)
  - modelbased (version 0.8.8; Makowski D et al., 2020)
  - report (version 0.5.8; Makowski D et al., 2023)
  - correlation (version 0.8.5; Makowski D et al., 2022)
  - latex2exp (version 0.9.6; Meschiari S, 2022)
  - here (version 1.0.1; Müller K, 2020)
  - tibble (version 3.2.1; Müller K, Wickham H, 2023)
  - datawizard (version 0.11.0; Patil I et al., 2022)
  - patchwork (version 1.2.0; Pedersen T, 2024)
  - R (version 4.4.1; R Core Team, 2024)
  - pacman (version 0.5.1; Rinker TW, Kurkiewicz D, 2018)
  - openxlsx (version 4.2.5.2; Schauberger P, Walker A, 2023)
  - ggplot2 (version 3.5.1; Wickham H, 2016)
  - forcats (version 1.0.0; Wickham H, 2023)
  - stringr (version 1.5.1; Wickham H, 2023)
  - tidyverse (version 2.0.0; Wickham H et al., 2019)
  - readxl (version 1.4.3; Wickham H, Bryan J, 2023)
  - dplyr (version 1.1.4; Wickham H et al., 2023)
  - purrr (version 1.0.2; Wickham H, Henry L, 2023)
  - readr (version 2.1.5; Wickham H et al., 2024)
  - scales (version 1.3.0; Wickham H et al., 2023)
  - tidyr (version 1.3.1; Wickham H et al., 2024)
═════════════════════════════════════════════════════════════════════════